(use-modules ((srfi srfi-18); (srfi srfi-9) (srfi srfi-1)
             #:renamer (symbol-prefix-proc 'original:)))

(use-modules
 (srfi srfi-19))
(include "replace-srfi-18.scm") 
(include "bloom.scm")

(define threadnumber ;contador/closure para identificar as threads
  (let ((init -1)) ;vai ser 0 após o incremento
    (lambda ()
      (set! init (+ 1 init))
      init)))

;; global vars
(define global-log '()) ;globallog: ((mutexname mutexlog) (mutexname 
(define program-start (current-time))

(define log!
  (lambda (obj threadname op)
    (let ((old-log (get-log obj)))
      (set-log! obj (cons
		     (list threadname op (current-time))
		     old-log)))))

(define add-to-global-log!
  (lambda (newmutex)
    (set! global-log (cons (list
			    (mutex-specific (get-mutex newmutex))
			    newmutex)
			   global-log))))

(define intercalate-logs
  (lambda ()
    ;passo 1: dividir a lista do log global em várias sublistas de seus eventos
    (let ((folded-log
	   (fold append '()			
		 (map
		  (lambda (a)
		    (let
			((mutex-number (car a))
			 (log (get-log (cadr a))))
		      (map (lambda (log-element)
			     (cons mutex-number log-element))
			   log)))
		  global-log))))
       ;passo 2: ordenar por tempo
      (sort-list folded-log (lambda (a b)
			      (cond
			       ((null? a )
				#f)
			       ((null? b)
				#t)
			       (#t
				(time<? (cadddr a) (cadddr b)))))))))

(define filter-by-mutex
  (lambda (log mutex)
    (filter (lambda (x) (equal? (car x) mutex)) log)))

(define filter-all-mutexes
  (lambda (log)
    (zip-with filter-by-mutex log (find-unique-mutexes log))))

(define find-unique-mutexes
  (lambda (log)
    (letrec
	((find-unique
	  (lambda (l par)
	    (if
	     (null? l)
	     par
	     (if
	      (member (caar l) par)
	      (find-unique (cdr l) par)
	      (find-unique (cdr l) (cons (caar l) par)))))))
      (find-unique log '()))))

(define zip-with
  (lambda (f args1 args2)
    (cond
     ((null? args1) '())
     ((null? args2) '())
     (#t (cons (f args1 (car args2)) (zip-with f args1 (cdr args2)))))))

(define find-lock-times ;FIXME- reduzir a função
;FIXME: isso assume que todas locks foram conseguidas, o que nao deve ser verdade sempre
  (lambda (log)
					; log: ((threadname op time) ... (threadname op time))
    (letrec
	(
	 (find-lock-try
	  (lambda (lista par)
	    (cond
	     ((null? lista)
	      par)
	     ((eq? (caddr (car lista)) 'lock-try)
	      (find-lock-success (cdr lista) (cons (car lista) par)))
	     (#t
	      (find-lock-try (cdr lista) par)))))
	 (find-lock-success
	  (lambda (lista par)
	    (cond
	     ((null? lista)
	      par)
	     ((eq? (caddr (car lista)) 'lock-acquire)

	      (find-lock-try     (cdr lista) (cons (car lista) par)))
	     (#t
	      (find-lock-success (cdr lista) par)))))
	 (calc-lock-times ; tempo = success-try
	  (lambda (mutexnumber log mint maxt total iter)
	    (cond 
	     ((or
	       (null? log) ;checa fim do log
	       (null? (cdr log)) ;FIXME: gambiarra para deadlocks
	       )
	      (if
	       (null? mutexnumber) ;verifica se no log houve locks
	       '() ;sem locks
	       (list mutexnumber mint maxt (/ (time-nanosecond total) iter) iter))) ;retorno
	     (#t ;se houve...
	      (let
		  ((td (time-difference
			(car (cdddr (car log)))
			(car (cdddr (car (cdr log)))))))
		(calc-lock-times
		 (caar log)
		 (cddr log)
		 (mintime (list mint td))
		 (maxtime (list maxt td))

		 (add-duration total td)
		 (+ 1 iter)))))))
	 (lock-log
	  (find-lock-try log '()))
	 )
       (calc-lock-times
	'() ;mutexnumber
	lock-log
	(time-difference (current-time) (make-time time-utc 0 0) ) ;time dif minimo - inicial alto
	(time-difference (make-time time-utc 0 0) (make-time time-utc 0 0) ) ;time dif max - inicial baixo
	(time-difference (make-time time-utc 0 0) (make-time time-utc 0 0)) ; time dif total
	1) ;iter
      )))


(define display-log
  (lambda (log) ;log: [(mNumber tName Op Time)]
    (map
     (lambda (l)
       (display "mutex number: ")
       (display (car l))
       (newline)
       (display "Thread name: ")
       (display (cadr l))
       (newline)
       (display "Operation: ")
       (display (caddr l))
       (newline)
       (display "Time- ")
       (display (time-nanosecond (cadddr l)))
       (newline))
     log)))

(define display-mutex-time-diff
   ; formato: (mutexname mint maxt (/ (time-nanosecond total) iter))) 
  (lambda (log)
    (display "Mutex number: ")
    (display (car log))
    (newline)
    (display "Min time: ")
    (display (cadr log))
    (newline)
    (display "Max time: ")
    (display (caddr log))
    (newline)
    (display "Average time: ")
    (display (cadddr log))
    (newline)))

(define maxtime
  (lambda (t)
    (letrec
	((maxt
	  (lambda (l max)
	    (if
	     (null? l)
	     max
	     (if
	      (time>? (car l) max)
	      (maxt (cdr l) (car l))
	      (maxt (cdr l) max))))))
      (maxt t (make-time time-utc 0 0)))))

(define mintime
  (lambda (t)
    (letrec
	((mint
	  (lambda (l min)
	    (if
	     (null? l)
	     min
	     (if
	      (time<? (car l) min)
	      (mint (cdr l) (car l))
	      (mint (cdr l) min))))))
      (mint t (current-time)))))

(define eliminate-empty-sublists
  (lambda (l)
    (letrec
	((elim
	  (lambda (ls arg)
	    (cond
	     ((null? ls)
	      arg)
	     (#t
	      (cond
	       ((null? (car ls))
		(elim (cdr ls) arg))
	       (#t
		(elim (cdr ls) (cons (car ls) arg)))))))))
      (elim l '()))))

(define thread-code
  (lambda (trh)
     (substring (object->string trh) 9 24)))

(set-hash-functions!
  (generate-hash-functions 5 thread-code))

(define (report-log)
  (display-log (intercalate-logs)))

(define (report-time-stats)
  (map display-mutex-time-diff (eliminate-empty-sublists (map find-lock-times (filter-all-mutexes (intercalate-logs))))))
